home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1993 / MacHack 1993.toast / MacHack™ 1987-1992 / MacHack™ '90 / MacHack 90 Contest Entries / Generic FKEY Installer ƒ / ThP Source / FKEY Installer.p < prev    next >
Encoding:
Text File  |  1990-06-15  |  7.7 KB  |  263 lines  |  [TEXT/PJMM]
  1. {    Generic FKEY Installer © 1990 by Jon Wind                                                        }
  2. {    Version 1.0 on 6/15/90                                                                                }
  3.  
  4.  
  5. {    This program is a generic FKEY installer shell, designed to install a single FKEY.  The            }
  6. {    FKEY to be installed must be located in the installer's resource fork along with an                }
  7. {    "STR " #128 with the name of the FKEY to be installed.  If the "STR " resource is                }
  8. {    missing, or does not match the name of the FKEY, the installer will not load.  If the            }
  9. {    Installer is unable to install the FKEY, it will beep.                                                }
  10.  
  11.  
  12. program FKEYinstaller;
  13.  
  14.  
  15.     const
  16.         DlgID = 128;
  17.         StrID = 128;
  18.         btn1 = 5;
  19.         btn2 = 6;
  20.         btn3 = 7;
  21.         btn10 = 14;
  22.         bCancel = 1;
  23.         bInstall = 2;
  24.         MaxBtnWidth = 135;
  25.         SysResFile = 0;
  26.         On = 1;
  27.         Off = 0;
  28.         Disable = 255;
  29.  
  30.     var
  31.         myResFile: Integer;
  32.         WatchCurs: CursHandle;
  33.  
  34.  
  35.  
  36.     procedure GetSetBtn (theDialog: DialogPtr; Btn, BtnState: Integer);
  37.   { update button status for dialog }
  38.         var
  39.             theType: Integer;
  40.             itmRect: Rect;
  41.             itmHdl: Handle;
  42.     begin
  43.         GetDItem(theDialog, Btn, theType, itmHdl, itmRect);      { get button junk }
  44.         if BtnState <> Disable then
  45.             begin
  46.                 HiliteControl(ControlHandle(itmHdl), Off);         { enable control }
  47.                 SetCtlValue(ControlHandle(itmHdl), BtnState)     { set button state }
  48.             end
  49.         else
  50.             HiliteControl(ControlHandle(itmHdl), BtnState);  { disable control }
  51.     end; { of proc GetSetBtn }
  52.  
  53.  
  54.     procedure RenameCtrl (theDialog: DialogPtr; ItemNumber: Integer; strvar: Str255);
  55.   { rename a control }
  56.         var
  57.             curname: Str255;
  58.             theType: Integer;
  59.             btnHdl: Handle;
  60.             btnRect: Rect;
  61.     begin
  62.         GetDItem(theDialog, ItemNumber, theType, btnHdl, btnRect);
  63.         GetCTitle(ControlHandle(btnHdl), curname);
  64.         if curname <> strvar then
  65.             SetCTitle(ControlHandle(btnHdl), strvar);
  66.     end;  { of proc RenameCtrl }
  67.  
  68.  
  69.     procedure DrawDefaultBtn (theDialog: DialogPtr; ItemNumber: Integer);
  70.   {  outline default button in dialog window }
  71.         var
  72.             theType: Integer;
  73.             btnHdl: Handle;
  74.             btnRect: Rect;
  75.     begin
  76.         SetPort(theDialog);                 { set window to current graf port }
  77.         GetDItem(theDialog, DialogPeek(theDialog)^.aDefItem, theType, btnHdl, btnRect);
  78.         Pensize(3, 3);                       { no wimpy button outlines here }
  79.         InsetRect(btnRect, -4, -4);             { set rectangle around button }
  80.         FrameRoundRect(btnRect, 16, 16);                   { draw the sucker! }
  81.         PenNormal;
  82.     end; { of proc DrawDefaultBtn }
  83.  
  84.  
  85.     procedure CenterAlert (theDialog: DialogPtr);
  86. { center dialog and hilight OK button }
  87.         var
  88.             itmrect: Rect;
  89.             itemHdl: Handle;
  90.             theType: Integer;
  91.             itemRect: Rect;
  92.     begin
  93.         SetPort(theDialog);                    { set window to current graf port }
  94.         with screenBits, theDialog^ do
  95.             MoveWindow(theDialog, ((bounds.right - bounds.left - portrect.right + portrect.left) div 2), ((bounds.bottom - bounds.top - portrect.bottom + portrect.top + 20) div 3), True);
  96.         GetDItem(theDialog, 3, theType, itemHdl, itemRect);  { get item's rect }
  97.         SetDItem(theDialog, 3, userItem + itemDisable, Handle(@DrawDefaultBtn), itemRect);
  98.     end;  { of proc CenterAlert }
  99.  
  100.  
  101.     function aNum2Str (aNum: LongInt): Str255;
  102.   { NumToString procedure available as a function }
  103.         var
  104.             NumStr: Str255;
  105.     begin
  106.         NumToString(aNum, NumStr);
  107.         aNum2Str := NumStr;
  108.     end; { of func aNum2Str }
  109.  
  110.     function GetFKEY (rezTitle: Str255; rezID, theRezFile: Integer): Handle;
  111. { return a Handle to the desired FKEY resource in the desired resource - returns nil if not found }
  112. { I would rather use CountResources and Get1IndResource, but I went for compatability instead }
  113.         var
  114.             aHndl: Handle;
  115.             foundID, index, oldResFile: Integer;
  116.             foundName: Str255;
  117.             found: Boolean;
  118.             theType: ResType;
  119.     begin
  120.         oldResFile := CurResFile;
  121.         UseResfile(theRezFile);
  122.         found := false;
  123.         for index := 1 to CountResources('FKEY') do
  124.             if not found then
  125.                 begin
  126.                     aHndl := GetIndResource('FKEY', index);
  127.                     if HomeResfile(aHndl) = theRezFile then
  128.                         begin
  129.                             GetResInfo(aHndl, foundID, theType, foundName);        { get name of resource }
  130.                             if Length(rezTitle) > 0 then
  131.                                 found := (foundName = rezTitle)        { found correctly named resource }
  132.                             else
  133.                                 found := (foundID = rezID);                { found correctly numbered resource }
  134.                         end
  135.                     else         { found a resource in the wrong file… }
  136.                         ReleaseResource(aHndl);
  137.                 end;
  138.         UseResfile(oldResFile);
  139.         if found then
  140.             GetFKEY := aHndl
  141.         else
  142.             GetFKEY := nil;
  143.     end;  { of func GetFKEY  }
  144.  
  145.  
  146.     procedure DoIt;
  147. { do everything… }
  148.         var
  149.             i, theItem, theSlot: Integer;
  150.             DlgPtr: DialogPtr;
  151.             StrHdl: StringHandle;
  152.             InstFKEYName, RezName: Str255;
  153.             ItemHdl, InstFKEYHdl: Handle;
  154.             theType: ResType;
  155.             goNext: Boolean;
  156.             theErr: OSErr;
  157.     begin
  158.         theSlot := 0;
  159.         StrHdl := GetString(StrID);
  160.         InstFKEYName := StrHdl^^;
  161.         if StrHdl <> nil then
  162.             begin
  163.                 InstFKEYHdl := GetFKEY(InstFKEYName, 0, myResFile);
  164.                 if InstFKEYHdl <> nil then
  165.                     begin
  166.                         DetachResource(InstFKEYHdl);
  167.                         HNoPurge(InstFKEYHdl);
  168.                         ParamText(InstFKEYName, '', '', '');
  169.                         DlgPtr := getNewDialog(DlgID, nil, Pointer(-1));
  170.                         CenterAlert(DlgPtr);
  171.  
  172.                         for i := btn1 to btn2 do
  173.                             GetSetBtn(DlgPtr, i, Disable);            { disable slots 1 & 2 }
  174.  
  175.                         for i := btn3 to btn10 do
  176.                             begin
  177.                                 if i < btn10 then
  178.                                     theItem := Succ(i - btn1)
  179.                                 else
  180.                                     theItem := 0;
  181.  
  182.                                 ItemHdl := GetFKEY('', theItem, 0);
  183.                                 if (ItemHdl <> nil) then                { found in System File… }
  184.                                     begin
  185.                                         GetResInfo(ItemHdl, theItem, theType, RezName);        { get name of resource }
  186.                                         if Length(RezName) = 0 then
  187.                                             RezName := '[No Name]';
  188.                                         ReleaseResource(ItemHdl);
  189.                                         RezName := Concat(aNum2Str(theItem), ' - ', RezName);
  190.                                         if StringWidth(RezName) > MaxBtnWidth then   { simple truncating algorithm }
  191.                                             begin
  192.                                                 RezName := Concat(RezName, '…');
  193.                                                 while StringWidth(RezName) > MaxBtnWidth do
  194.                                                     Delete(RezName, Pred(Length(RezName)), 1);
  195.                                             end;
  196.                                         RenameCtrl(DlgPtr, i, RezName);        { set button name }
  197.                                         goNext := True;
  198.                                     end;
  199.                             end;
  200.  
  201.                         ShowWindow(DlgPtr);
  202.                         initCursor;
  203.  
  204.                         repeat
  205.                             if theSlot = 0 then
  206.                                 GetSetBtn(DlgPtr, bInstall, Disable)
  207.                             else
  208.                                 GetSetBtn(DlgPtr, bInstall, Off);
  209.                             ModalDialog(nil, theItem);
  210.                             case theItem of
  211.                                 bInstall: 
  212.                                     begin
  213.                                         SetCursor(WatchCurs^^);
  214.                                         UseResFile(SysResFile);
  215.                                         theErr := noErr;
  216.                                         theSlot := Succ(theSlot - btn1);            { adjust installation slot flag to real FKEY slot number }
  217.                                         ItemHdl := GetFKEY('', theSlot, 0);
  218.                                         if (ItemHdl <> nil) then                        { found in System File… }
  219.                                             begin
  220.                                                 RmveResource(ItemHdl);
  221.                                                 theErr := ResError;
  222.                                                 DisposHandle(ItemHdl);
  223.                                             end;
  224.  
  225.                                         if theErr = noErr then
  226.                                             begin
  227.                                                 AddResource(InstFKEYHdl, 'FKEY', theSlot, InstFKEYName);
  228.                                                 if ResError = noErr then
  229.                                                     WriteResource(InstFKEYHdl)
  230.                                                 else
  231.                                                     SysBeep(3);
  232.                                                 UpdateResFile(0);
  233.                                             end
  234.                                         else
  235.                                             SysBeep(3);
  236.  
  237.                                     end;
  238.                                 Btn1..Btn10: 
  239.                                     begin
  240.                                         if theSlot > 0 then                        { slot flag is used here to save the selected button number }
  241.                                             GetSetBtn(DlgPtr, theSlot, Off);
  242.                                         theSlot := theItem;
  243.                                         GetSetBtn(DlgPtr, theSlot, On);
  244.                                     end;
  245.                                 otherwise
  246.                             end;
  247.                         until (theItem = bCancel) or (theItem = bInstall);
  248.                         DisposDialog(DlgPtr);
  249.                         HPurge(InstFKEYHdl);
  250.                         ReleaseResource(InstFKEYHdl);
  251.                     end;
  252.             end;
  253.     end;  { of proc Initialize }
  254.  
  255.  
  256. begin
  257.     WatchCurs := GetCursor(watchcursor);    { read in from system resource }
  258.     MoveHHi(Handle(WatchCurs));            { to avoid fragging when it's locked }
  259.     HLock(Handle(WatchCurs));                { lock the handle down }
  260.     SetCursor(WatchCurs^^);                    { bring up watch cursor ASAP }
  261.     myResFile := CurResFile;
  262.     DoIt;
  263. end.